home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CU Amiga Super CD-ROM 11
/
CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso
/
propage
/
genies
/
frenchgenies
/
rexx
/
histogrammevertical.pprx
< prev
next >
Wrap
Text File
|
1993-08-03
|
4KB
|
176 lines
/*@BHistogrammeVertical @P@I© Michael S. Fahrion. Janvier 1992
Debuggé et amélioré par Don Cox.
Ce Genie crée un histogramme vertical à partir des données fournies par l'utilisateur.
*/
/*@BMakeBarChart_Vert @P@ICopyright Michael S. Fahrion. Jan., 1992
Makes a simple vertical bar chart from data entered by the user.
(This version debugged/enhanced by Don Cox).
*/
numeric digits 8
cr = '0a'x
call SafeEndEdit.rexx()
call ppm_AutoUpdate(0)
call ppm_NewGroup()
units = ppm_GetUnits()
call ppm_SetUnits(1)
signal on halt
signal on break_c
signal on break_e
signal on break_d
box = ppm_ClickOnBox("Cliquez sur la boîte destinée à contenir l'histogramme...")
if box = 0 then
do
call ppm_Inform(1, "Aucune boîte n'est sélectionnée",)
call ppm_ClearStatus()
exit
end
/* extract box attributes */
boxsize = ppm_GetBoxSize(box)
boxpos = ppm_GetBoxPosition(box)
if ppm_Inform(2, "Effacer cette boîte ?",) = 1 then call ppm_DeleteBox(box)
boxwidth = word(boxsize, 1)
boxheight = word(boxsize, 2)
boxleft = word(boxpos, 1)
boxtop = word(boxpos, 2)
/*trace(results)*/
nmbars = GetUserText(4, "Nombre de données")
if nmbars > 12 then exit_msg("Le nombre de données ne doit pas être supérieur à 12")
form = ' Valeur 1'
do x = 2 while x <= nmbars
form = form cr 'Valeur' x
end
form = form cr 'Echelle'
form = ppm_GetForm("Données de l'histogramme",6,form)
if form = "" then exit_msg("Opération annulée")
x = 1
do forever
parse var form bdata.x '0a'x form
if bdata.x = "" then leave
x = x + 1
end
tchart = nmbars + 1
topchart = bdata.tchart
form = ' Légende 1'
do x = 2 while x <= nmbars
form = form cr 'Légende' x
end
form = ppm_GetForm("Légende de l'histogramme",8,form)
if form = "" then exit_msg("Opération annulée")
x = 1
do forever
parse var form blabel.x '0a'x form
if bdata.x = "" then leave
x = x + 1
end
facelist = ppm_GetTypeFaceList()
facelist = substr(facelist, pos('0a'x, facelist) +1) /*strip off the number*/
face = ppm_SelectFromList("Choix de la Police",32,18,0,facelist)
/* Draw background chart and grid lines */
barbottom = boxtop + boxheight
call ppm_ShowStatus("Création de l'histogramme")
linespace = boxheight / 10
yline = linespace + boxtop
call ppm_SetLineWeight(.5)
do 9
call ppm_DrawLine(boxleft, yline, boxleft + boxwidth, yline)
yline = yline + linespace
call ppm_AddToGroup()
end
call ppm_SetLineWeight(1)
call ppm_SetFillPattern(0)
call ppm_DrawRect(boxleft, boxtop, boxleft + boxwidth, boxtop + boxheight)
call ppm_AddToGroup()
call ppm_MergeGroup()
/* add chart numbers */
call ppm_SetFont(face)
call ppm_SetSize(10)
call ppm_SetStyle(N)
call ppm_SetJustification(1)
bleft = boxleft - .55
btop = boxtop - .01
ctext = topchart
ctextadjust = topchart / 10
i = 1
do 11
cbox = ppm_CreateBox(bleft, btop, .5, .25, 0)
btop = btop + linespace
call ppm_TextIntoBox(cbox, ctext)
ctext = topchart - (ctextadjust * i)
i = i + 1
end
/* Draw chart bars and put on labels */
barcalc = boxheight / topchart
barspace = (nmbars + 1) * .125
barwidth = (boxwidth - barspace) / nmbars
barpos = boxleft + .125
call ppm_SetFillPattern(5)
call ppm_SetJustification(2)
call ppm_SetLineSpacing(2,100)
i = 1
do nmbars
call ppm_ShowStatus("Travail en cours sur la donnée : " i)
barheight = bdata.i * barcalc
bartop = barbottom - barheight
call ppm_DrawRect(barpos, bartop, barpos + barwidth, barbottom)
cbox = ppm_CreateBox(barpos, barbottom + .03, barwidth, .4, 0)
call ppm_TextIntoBox(cbox, upper(blabel.i))
cbox = ppm_CreateBox(barpos, bartop - .2, barwidth, .15, 0)
call ppm_SetBoxTransparent(cbox, 0)
call ppm_TextIntoBox(cbox, bdata.i)
barpos = barpos + barwidth + .125
i = i + 1
end
exit_msg("Terminé")
break_d:
break_e:
break_c:
halt:
call exit_msg("Abandon du Genie par l'utilisateur !")
exit_msg: procedure expose units
do
parse arg message
call ppm_ClearStatus()
if message ~= '' then
call ppm_Inform(1, message,)
call ppm_SetUnits(units)
call ppm_ClearStatus()
call ppm_AutoUpdate(1)
exit
end